HPAVC/HPAVC CD-ROM.iso/pc/KMAGV2.ZIP/FADEEXAM.PAS

Pascal/Delphi Source File | 1995-10-23 | 5.5 KB | 166 lines

{FADEEXAM.PAS / EXAMPLE FOR FADE SCREEN}
{WRITING BY THE KING IN 10/22/95       }
Uses Crt;
Type
    RGB = Record                           {A Record Of Red,Green,Blue}
        R,G,B:Byte;
    End;
    PalType = Array[0..255] Of RGB;        {256 Color Of Red Green Blue}
Var
    Pal : PalType;                         {Palette For Start}
    Pal1 : PalType;                        {Palette For The Picture}

{-------------------------------------------------------}
{Get Red Green And Blue From a Color                    }
{-------------------------------------------------------}

Procedure GetColor(Col:Byte;Var R,G,B:Byte);Assembler;
ASM
    Mov Dx,3c7H                  {Set To GET COLOR}
    Mov Al,Col
    Out Dx,Al
    Inc Dx                       {Dx = 3c8H}
    Inc Dx                       {Dx = 3c9H}
    Les Di,R                     {Es:Di = R}
    In Al,Dx                     {Get Red Value}
    Mov [Es:Di],Al               {R = Red Value}
    In Al,Dx                     {Get Green Value}
    Les Di,G                     {Es:Di = G}
    Mov [Es:Di],Al               {G = Green Value}
    In Al,Dx                     {Get Blue Value}
    Les Di,B                     {Es:Di = B}
    Mov [Es:Di],Al               {B = Blue Value}
END;

{-------------------------------------------------------}
{Set Red Green And Blue To a Color                      }
{-------------------------------------------------------}

Procedure SetColor(Col:Byte;R,G,B:Byte);Assembler;
Asm
    Mov Dx,3c8h                  {SET TO SET COLOR}
    Mov Al,Col
    Out Dx,Al
    Inc Dx                       {DX = 3c9h}
    Mov Al,R                     {Senting Red Value}
    Out Dx,Al
    Mov Al,G                     {Senting Green Value}
    Out Dx,Al
    Mov Al,B                     {Senting Blue Value}
    Out Dx,Al
End;
{------------------------------------------------}
{Set Mode To Mode 13H , 320x200x256 Colors..     }
{------------------------------------------------}

Procedure SetMode;Assembler;
Asm
       Mov Ah,00h  {Function 00,13 Interrupt 10h / SET MODE}
    Mov Al,13h
    Int 10h     {SETING TO MODE 13H}
End;
{------------------------------------------------}
{Plot a single pixel on the screen .             }
{------------------------------------------------}
Procedure PutPixel(X,Y:Integer;Col:Byte);Assembler;
Asm
    Mov Ax,0a000h     {Ax = SEGMENT OF THE SCREEN}
    Mov Es,Ax         {Es = SEGMENT OF THE SCREEN}
    Mov Ax,320        {Ax = MAX VERTICAL LINE}
    Mul Y             {Ax = AX * Y = HORIZONTAL LINE}
    Add Ax,X          {Ax = VERTICAL LINE + HORIZONTAL LINE = OFFSET}
    Mov Di,Ax         {DI = OFFSET}
    Mov Al,Col        {AL = COLOR}
    StoSb             {[0A000h:OFFSET] = COLOR}
End;
{------------------------------------------------}
{Set Mode To Mode 3H , 80x25x16 Colors..         }
{------------------------------------------------}
Procedure SetTextMode;Assembler;
Asm
    Mov Ah,00h {Function 00,3 Interrupt 10h / SET MODE}
    Mov Al,3h
    Int 10h    {SET MODE TO MODE 3 / TEXT MODE}
End;
{---------------------------------------------------}
{ Make a BLACK Palette                              }
{---------------------------------------------------}
Procedure ZeroPal(Var Pal:PalType);
Begin
    FillChar(Pal,SizeOf(Pal),0);
End;
{---------------------------------------------------}
{ Show The Palette                                  }
{---------------------------------------------------}
Procedure ShowPal(Var Pal:PalType);
Var T:Byte;
Begin
    For T:=0 To 255 Do
        SetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
End;
{---------------------------------------------------}
{ Get The Use Palette From The Screen               }
{---------------------------------------------------}

Procedure GetPal(Var Pal:PalType);
Var T:Byte;
Begin
    For T:=0 To 255 Do
        GetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
End;
{---------------------------------------------------}
{ Fill The Screen With Random Dots.                 }
{---------------------------------------------------}

Procedure FillPoints;
Var
    T:Word;
Begin
    For T:=1 To 65535 Do
    Begin
        PutPixel(Random(319),Random(199),Random(255));
    End;
End;
{---------------------------------------------------}
{ Fade To The Screen From Palette To Palette.       }
{---------------------------------------------------}
Procedure FadeTo(Pal,ToPal:PalType);
Var
    T,T1:Byte;
Begin
    For T1:=1 To 63 Do
    Begin
        For T:=1 To 255 Do
        Begin
            If Pal[T].R > ToPal[T].R Then
                Dec(Pal[T].R);
            If Pal[T].R < ToPal[T].R Then
                Inc(Pal[T].R);
            If Pal[T].G > ToPal[T].G Then
                Dec(Pal[T].G);
            If Pal[T].G < ToPal[T].G Then
                Inc(Pal[T].G);
            If Pal[T].B > ToPal[T].B Then
                Dec(Pal[T].B);
            If Pal[T].B < ToPal[T].B Then
                Inc(Pal[T].B);
        End;
        ShowPal(Pal);
        Delay(20);   {Can Be Change To What Speed You Want}
    End;
End;
Begin
                            {MAIN PROGRAM}

    SetMode;               {Set To 320X200X256 Mode}
    GetPal(Pal);           {Get Palette To Pal}
    ZeroPal(Pal1);         {Make Pal1 Black Palette}
    ShowPal(Pal1);         {Show The Black Palette That On Pal1}
    FillPoints;            {Fill The Screen With Points}
    FadeTo(Pal1,Pal);      {Fade From Black Screen To Pal}
    Repeat
    Until(Keypressed);     {Wait For KeyPressed}
    FadeTo(Pal,Pal1);      {Fade From Pal To Black Screen}
    SetTextMode;           {Set To Text Mode Screen}
    Writeln('Thanks For Watching My Example.');
End. {End Program}